home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / EDWIN / STRCOMP.S < prev    next >
Encoding:
Text File  |  1993-06-15  |  4.4 KB  |  139 lines
  1. ;;;
  2. ;;;    Copyright (c) 1985 Massachusetts Institute of Technology
  3. ;;;
  4. ;;;    This material was developed by the Scheme project at the
  5. ;;;    Massachusetts Institute of Technology, Department of
  6. ;;;    Electrical Engineering and Computer Science.  Permission to
  7. ;;;    copy this software, to redistribute it, and to use it for any
  8. ;;;    purpose is granted, subject to the following restrictions and
  9. ;;;    understandings.
  10. ;;;
  11. ;;;    1. Any copy made of this software must include this copyright
  12. ;;;    notice in full.
  13. ;;;
  14. ;;;    2. Users of this software agree to make their best efforts (a)
  15. ;;;    to return to the MIT Scheme project any improvements or
  16. ;;;    extensions that they make, so that these may be included in
  17. ;;;    future releases; and (b) to inform MIT of noteworthy uses of
  18. ;;;    this software.
  19. ;;;
  20. ;;;    3.  All materials developed as a consequence of the use of
  21. ;;;    this software shall duly acknowledge such use, in accordance
  22. ;;;    with the usual standards of acknowledging credit in academic
  23. ;;;    research.
  24. ;;;
  25. ;;;    4. MIT has made no warrantee or representation that the
  26. ;;;    operation of this software will be error-free, and MIT is
  27. ;;;    under no obligation to provide any services, by way of
  28. ;;;    maintenance, update, or otherwise.
  29. ;;;
  30. ;;;    5.  In conjunction with products arising from the use of this
  31. ;;;    material, there shall be no use of the name of the
  32. ;;;    Massachusetts Institute of Technology nor of any adaptation
  33. ;;;    thereof in any advertising, promotional, or sales literature
  34. ;;;    without prior written consent from MIT in each case.
  35. ;;;
  36. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  37. ;;;
  38. ;;;     Modified by Texas Instruments Inc 8/15/85
  39. ;;;
  40. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  41.  
  42. ;;; 4:01pm  Tuesday, 25 June 1985
  43. (begin
  44. (define-integrable char-equal-ci? char-ci=?)
  45.  
  46. (define-integrable char-equal? char=?)
  47.  
  48. (define-integrable char-less-ci? char-ci<?)
  49.  
  50. (define-integrable char-less? char<?)
  51.  
  52. (define-integrable string-equal-ci? string-ci=?)
  53.  
  54. (define-integrable string-equal? string=?)
  55.  
  56. (define-integrable string-less-ci? string-ci<?)
  57.  
  58. (define-integrable string-less? string<?)
  59.  
  60. (define-integrable substring-equal-ci? substring-ci=?)
  61.  
  62. (define-integrable substring-equal? substring=?)
  63.  
  64. (define-integrable substring-less-ci? substring-ci<?)
  65.  
  66. (define-integrable  substring-less? substring<?)
  67.  
  68. (define-integrable char= char=?)
  69.  
  70. (define-integrable char< char<?)
  71.  
  72. )
  73. (define char-upper-case?
  74.    (lambda (c)
  75.      (char=? (char-upcase c) c)))
  76.  
  77. (define char-lower-case?
  78.    (lambda (c)
  79.      (char=? (char-downcase c) c)))
  80.  
  81. (macro string-allocate
  82.    (lambda (e)
  83.      (list 'make-string (cadr e) #F)))
  84.  
  85.  
  86.  
  87. ;;;; Comparison Primitives
  88.  
  89. (define substring-match-forward)
  90. (define substring-match-forward-ci)
  91.  
  92. (let ()
  93.   (define (make-substring-match-forward char-equal?)
  94.     (lambda (string1 start1 end1 string2 start2 end2)
  95.       (define (loop index1 index2 n)
  96.     (if (or (= index1 end1)
  97.         (= index2 end2)
  98.         (not (char-equal? (string-ref string1 index1)
  99.                   (string-ref string2 index2))))
  100.         n
  101.         (loop (1+ index2) (1+ index2) (1+ n))))
  102.       (loop start1 start2 0)))
  103.   (set! substring-match-forward
  104.     (make-substring-match-forward char-equal?))
  105.   (set! substring-match-forward-ci
  106.     (make-substring-match-forward char-equal-ci?)))
  107.  
  108. (define string-match-forward)
  109. (define string-match-forward-ci)
  110.  
  111. (let ()
  112.   (define (string-comparison substring-comparison)
  113.     (lambda (string1 string2)
  114.       (substring-comparison string1 0 (string-length string1)
  115.                 string2 0 (string-length string2))))
  116.   (set! string-match-forward
  117.     (string-comparison substring-match-forward))
  118.   (set! string-match-forward-ci
  119.     (string-comparison substring-match-forward-ci)))
  120.  
  121. ;;;; Character Search Primitives
  122.  
  123. (define substring-find-next-char-ci
  124.   (lambda (string start end char)
  125.     (let ((char1 (char-upcase char))
  126.           (char2 (char-downcase char)))
  127.       (let ((set (make-string 2 char1)))
  128.         (substring-find-next-char-in-set string start end 
  129.                                          (string-set! set 1 char2))))))
  130.  
  131. (define substring-find-previous-char-ci
  132.   (lambda (string start end char)
  133.     (let ((char1 (char-upcase char))
  134.           (char2 (char-downcase char)))
  135.       (let ((set (make-string 2 char1)))
  136.         (substring-find-previous-char-in-set string start end 
  137.                                          (string-set! set 1 char2))))))
  138.  
  139.